#lang rosetta-racket


(provide backend-autocad-template
         render-with-floor
         render-with-floor!)


(define template-path (path->string (build-path (apps-dir) "autocad-render\\template.dwt")))


(define (render-path file dir ext)
  (format "~A~A.~A" (path->string dir) file ext))

(define (display-render-msg width height path)
  (displayln (format "Render (~Ax~A) ~A" width height path)))


(define (backend-autocad-template)
  (backend autocad)
  (ac:close #f)
  (ac:open template-path))


(define (make-render-shape shape)
  (ac:layer "DarkGray")
  (evaluate shape))

(define (make-render-floor floor-width floor-height floor-color)
  (let ((floor-layer (case floor-color
                       ('white "Floor")
                       ('black "FloorBlack")
                       (else (error 'make-render-floor (format "Floor color must be 'white or 'black, given ~A" floor-color)))))
        (z-min (reduce min (map bbox-min-z (map bbox (get-shapes))))))
    (ac:layer floor-layer)
    (evaluate (move-z z-min (surface (rectangle floor-width floor-height))))))

(define (render-shape-and-floor node width height path floor-width floor-height floor-color)
  (begin0
    (make-render-shape node)
    (let ((floor (make-render-floor floor-width floor-height floor-color)))
      (ac:com:set-sky-status-variable ac:com:sky-status-background-and-illumination)
      (ac:layer "DarkGray")
      (render-shapes width height path)
      (delete-shape floor)
      (void))))

(define (render-with-floor-impl node file dir ext width height floor-width floor-height floor-color)
  (let ((path (render-path file dir ext)))
    (display-render-msg width height path)
    (render-shape-and-floor node width height path floor-width floor-height floor-color)))

(define (render-with-floor #:dir (dir (render-dir))
                           #:ext (ext (render-ext))
                           #:width (width (render-width))
                           #:height (height (render-height))
                           #:floor-width (floor-width (render-floor-width))
                           #:floor-height (floor-height (render-floor-height))
                           #:floor-color (floor-color (render-floor-color))
                           . args)
  (match args
    ((list node file)
     (render-with-floor-impl node file dir ext width height floor-width floor-height floor-color))
    ((list node file center target)
     (render-with-floor-impl (view center target node) file dir ext width height floor-width floor-height floor-color))
    ((list node file center target projection)
     (render-with-floor-impl (view center target projection node) file dir ext width height floor-width floor-height floor-color))
    ((list node file center target projection lens)
     (render-with-floor-impl (view center target projection lens node) file dir ext width height floor-width floor-height floor-color))))

(define (render-with-floor! #:dir (dir (render-dir))
                            #:ext (ext (render-ext))
                            #:width (width (render-width))
                            #:height (height (render-height))
                            #:floor-width (floor-width (render-floor-width))
                            #:floor-height (floor-height (render-floor-height))
                            #:floor-color (floor-color (render-floor-color))
                            . args)
  (match args
    ((list file)
     (render-with-floor-impl λid file dir ext width height floor-width floor-height floor-color))
    ((list file center target)
     (render-with-floor-impl (view center target λid) file dir ext width height floor-width floor-height floor-color))
    ((list file center target projection)
     (render-with-floor-impl (view center target projection λid) file dir ext width height floor-width floor-height floor-color))
    ((list file center target projection lens)
     (render-with-floor-impl (view center target projection lens λid) file dir ext width height floor-width floor-height floor-color))))